perm filename TELNET.MID[S,NET]6 blob
sn#712325 filedate 1983-05-19 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00035 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE TELNET
C00007 00003 X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK BSACT NIORTS ERRHAN ERRINS ERRTNS HSTTAB
C00010 00004 CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP CRONLY INSDLP CRP GETXPP GETYPP XPOS LSTESC ESCMOD ARGC ARGV ARGMAX RCBINP TRBINP ECHOP SUPGAP MORTLP DSIBF DSOBF TTOBFR TTOCTR TTOPTR HNUMTB HNUMSZ HPRITB COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF HSTEND DEBUGP MONCMP OTNCMP DPYP DMDPYP NOEDTP ESCHAR SMRBLK NETTAB NNETS NETPRI
C00017 00005 TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
C00020 00006 INTSER INTSR0 INTSR1 INTSR2
C00022 00007 TELNET MONDLM SEMDLM SCNARG
C00024 00008 SCNAR1 SCNAR2 CHKTTY
C00026 00009 TOPLEV GETHST GETHS1 GETHCH FLSHEX GLOBSW
C00030 00010 GOTHST NOTNSW SKTLUZ
C00034 00011 HSTSPC GOTHSN GOTHS1 GOTHS2 HSTLUZ ALPHST MISSWT
C00037 00012 CHKHNM HNUMLP HNUMEN GOTHDB NOSYS HPRILP HPRIL1 HPRIL2 HPRIL3 HPRIL4 HPRIL5
C00042 00013 GOICP GOICP0 GOIC0A GOICP1 ICPFAI NOICP GOICP2 NOTPUP NOTPRT GOICP3 GOICP4
C00048 00014 SLEEPR SLEPRX SLEPR1 GETDCH SNCH CONERR
C00051 00015 TTISER TTISR4 TTISR2 HAKCOM
C00055 00016 CHRHAK CHRHK0 CHRHK2 CHRHK1 TTISR1 TTISR9 TTISR3
C00059 00017 NTISER NTISR2 NTISR4
C00062 00018 NTISR1 NTIS1A NTISR6 NTISR5 NTISR3 NTISR7 NTISR8
C00066 00019 IACSER TPLMSG OPTMSG RNDMSG
C00068 00020 WILLSR WILBAD WONTSR
C00071 00021 DOSR DONTSR
C00073 00022 DCHOUT DCHCKY DCHSND DCHPRT CPOPJ
C00075 00023 DMCTAB
C00078 00024 ESCONT ESCL1 ESCL2 BADESC
C00081 00025 ESCTB1
C00083 00026 CMCDSP
C00085 00027 ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
C00087 00028 ECHATM LCHATM CLSCON SCRFIX PUNT DBUG NDBUG
C00089 00029 ETRANS LTRANS ESCSET
C00092 00030 APPEND DAPPND
C00095 00031 CLSOFL OPNOFL
C00097 00032 CLSIFL OPNIFS OPNIFL
C00099 00033 DDTCAL HLPMES
C00101 00034 GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
C00104 00035 OUTSIX OUTSX1 GETSIX GETSX1 SWINIR SWINR1 SWINR2 ...LIT
C00108 ENDMK
C⊗;
TITLE TELNET
SUBTTL Definitions
; Mark Crispin, SU-AI, October 1980
; Assembly switches
IFNDEF OPRSKT,OPRSKT==1 ; old protocol ICP socket
IFNDEF NPRSKT,NPRSKT==27 ; default (new protocol) ICP socket
IFNDEF HSTNLN,HSTNLN==10. ; host name buffer length
IFNDEF PDLLEN,PDLLEN==50. ; PDL length
IFNDEF TTOBFL,TTOBFL==50. ; TTY output buffer length
IFNDEF CLKSPD,CLKSPD==2. ; number of seconds between clock ints
IFNDEF LOKTMO,LOKTMO==60./CLKSPD ; # of seconds for lock timeout
IFNDEF FTALTN,FTALTN==1 ; try alternate host addresses
IFNDEF FTF2,[ IFDEF F2UUO,FTF2==1 ; set automatically nonzero for F2
.ELSE FTF2==0
];IFNDEF FTF2
IF1,[
IFNDEF FTDPYP,[
FTDPYP==0
PRINTX/FTDPYP (≠0 → display hacking) == /
.TTYMAC FOO
IFNB [FOO][FTDPYP==FOO]
TERMIN
];IFNDEF FTDPYP
IFN FTF2,[PRINTX/
F2 WAITS version
/];IFN FTF2
];IF1
IF2,[
IFN FTDPYP,[
IFN FTDPYP&1,[
PRINTX/DM simulator version!
/
];IFN FTDPYP&1
IFN FTDPYP&2,[
PRINTX/ANSI simulator version!
/
];IFN FTDPYP&2
];IFN FTDPYP
];IF2
;X DSI INTTTY INTCLK DISLIN DMLIN DDDLIN PTYLIN IMPBIT SPCBRK BSACT NIORTS ERRHAN ERRINS ERRTNS HSTTAB
; AC definitions. 0→3 (and, at HSTNAM, 4→11) are used by NETWRK.
; 0→6 are used by DISPLY.
; 0 is also used as very temp in the main program.
; X, Y, Z, A, and B are in approximate descending order of usage.
X=7 ? Y=10 ? Z=11 ? A=12 ? B=13 ? P=17
; I/O channels. NETWRK uses 0 and 1.
DSI==2 ? DSO==3
; Macro to send a TELNET command
DEFINE TELCMD CMDLST
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗!CMDLST!*
/]
IRPS CMD,,CMDLST
MOVEI CMD
PUSHJ P,NETOCH
TERMIN
PUSHJ P,NETSND
TERMIN
; SAIL system bit definitions
INTTTY==020000,, ; TTY input interrupt
INTCLK==000200,, ; clock interrupt
DISLIN==400000,, ; III
DMLIN== 040000,, ; DM
DDDLIN==020000,, ; DD
PTYLIN==004000,, ; PTY
IMPBIT==001000,, ; IMP TTY
SPCBRK==000100,, ; special activation mode
BSACT== 000020 ; activate on backspace
; Include wonderful network routines
NIORTS==-1 ; include I/O routines
ERRHAN==-1 ; include automagic error handling
ERRINS==IF1,[0] .ELSE JRST CONERR ; error instruction
ERRTNS==-1 ; include error routines
HSTTAB==-1 ; include host table routines
MRKCHR==-1 ; read mark bytes as characters
.INSRT NETWRK
; This should have been exported by NETWRK
NW%SU==:44 ;SUnet
NW$BYT==:331100 ;Byte pointer to network number
; Include magic display routines
IFN FTDPYP,.INSRT DISPLY
;CORBEG FSPBLK INPFLN INPEXT INPPPN OUTFLN OUTEXT OUTPPN TTINTP NTINTP NTOINP CLSINP ISLURP NTBFOP NETCMP INPFLP SLOWFP OUTFLP CHARMP NPROTP CRONLY INSDLP CRP GETXPP GETYPP XPOS LSTESC ESCMOD ARGC ARGV ARGMAX RCBINP TRBINP ECHOP SUPGAP MORTLP DSIBF DSOBF TTOBFR TTOCTR TTOPTR HNUMTB HNUMSZ HPRITB COREND PDL IDLTIM HSTBEG HSPBUF HNMBUF HSTEND DEBUGP MONCMP OTNCMP DPYP DMDPYP NOEDTP ESCHAR SMRBLK NETTAB NNETS NETPRI
SUBTTL Data area
CORBEG==.
FSPBLK: BLOCK 4 ; filespec block
INPFLN: BLOCK 1 ; input filename stuff
INPEXT: BLOCK 1
INPPPN: BLOCK 1
OUTFLN: BLOCK 1 ; output filename stuff
OUTEXT: BLOCK 1
OUTPPN: BLOCK 1
; Flags
TTINTP: BLOCK 1 ; -1 → TTI interrupt
NTINTP: BLOCK 1 ; -1 → NTI interrupt
NTOINP: BLOCK 1 ; ≤ -1 → output should be flushed
CLSINP: BLOCK 1 ; -1 → connection closing
ISLURP: BLOCK 1 ; -1 → in input slurping mode
NTBFOP: BLOCK 1 ; -1 → something in net buffer
NETCMP: BLOCK 1 ; -1 → network command in progress
INPFLP: BLOCK 1 ; -1 → input file opened
SLOWFP: BLOCK 1 ; -1 → input in slow mode
OUTFLP: BLOCK 1 ; -1 → output file opened
CHARMP: BLOCK 1 ; -1 → in character mode
NPROTP: BLOCK 1 ; -1 → using new protocol
CRONLY: BLOCK 1 ; -1 → suppress LF's for Pup Telnet
IFE FTDPYP,TRANSP: BLOCK 1 ; -1 → transparent mode
.ELSE [
INSDLP: BLOCK 1 ; -1 → insert/delete mode on
CRP: BLOCK 1 ; -1 → last character CR, ignore LF
GETXPP: BLOCK 1 ; -1 → get X position
GETYPP: BLOCK 1 ; -1 → get Y position
XPOS: BLOCK 1 ; X position
IFE FTDPYP&2,QUOTEP: BLOCK 1 ; -1 → control character quoting
.ELSE [
LSTESC: BLOCK 1 ; last escape character seen
ESCMOD: BLOCK 1 ; < 0 → escape processing.
ARGC: BLOCK 1 ; Number of arguments seen - 1
ARGV: BLOCK 10 ; Arguments to ESC [ ...
ARGMAX==.-ARGV ; ]
];IFN FTDPYP&2
];IFN FTDPYP
; Connection option flags
IRPS OPT,,WILL WONT DO DONT
OPT!P: BLOCK 1 ; -1 → option in effect
TERMIN
RCBINP: BLOCK 1 ; -1 → receiving binary
TRBINP: BLOCK 1 ; -1 → transmitting binary
ECHOP: BLOCK 1 ; -1 → remote echoing
SUPGAP: BLOCK 1 ; -1 → suppressing GA
MORTLP: BLOCK 1 ; -1 → foreign job mortality
; Buffer and other stuff
DSIBF: BLOCK 3 ; disk input buffer
DSOBF: BLOCK 3 ; disk output buffer
IFE FTDPYP,[
TTOBFR: BLOCK TTOBFL ; TTY output buffer
TTOCTR: BLOCK 1 ; TTY output counter
TTOPTR: BLOCK 1 ; TTY output pointer
];IFE FTDPYP
; Tables for multiple addresses
IFN FTALTN,[
HNUMTB: BLOCK 5 ; table of possible host addresses
HNUMSZ==.-HNUMTB
HPRITB: BLOCK HNUMSZ ; priority to use given networks
];IFN FTALTN
COREND==.-1
; Protected storage
PDL: BLOCK PDLLEN ; pushdown list
IDLTIM: BLOCK 1 ; idle timeout count
HSTBEG==.
HSPBUF: BLOCK HSTNLN ; host argument stored here
HNMBUF: BLOCK HSTNLN ; host name stored here
HSTEND==.-1
DEBUGP: 0 ; -1 → MRC is fooling around
MONCMP: 0 ; -1 → monitor command
OTNCMP: 0 ; -1 → OTN monitor command
IFE FTDPYP,[
DPYP: 0 ; -1 → display terminal
DMDPYP: 0 ; -1 → DM display
NOEDTP: 0 ; 1 → NOEDIT display (else zero)
ESCHAR: ↑↑ ; escape character for printing consoles
];IFE FTDPYP
USRSKT: 0 ; explicit socket number
SMRBLK: 25 ; send Mark (this ought to be in NETWRK)
0 ; status word
6 ; Timing Mark Reply
;Table of networks and their priority to use
;This table is HOST DEPENDENT
IFN FTALTN,[
;Table of known networks
NETTAB: NW%ARP ;ARPAnet
IFE FTF2,NW%SU ;SU-NET
NETTSZ==.-NETTAB
;Table of corresponding priorities
NETPRI: ARPPRI::7 ;NW%ARP ;Lower than Ethernet, as is flakey
IFE FTF2,ETHPRI::10 ;NW%SU
XWD -2,0 ;Unknown network
;Table of corresponding names
NETNAM: [ASCIZ/ARPAnet/]
IFE FTF2,[[ASCIZ/Ethernet/]]
IFN FTF2,ETHPRI:10 ;make sure this is defined to avoid more conditionals
];IFN FTALTN
;TPLTAB TPLMIN WDOTAB WDOMAX EXOPL RNDYLZ
SUBTTL TELNET protocol codes
DEFINE TPC CODE
CODE
IRPS NAME,,CODE
[ASCIZ/NAME/]
.ISTOP
TERMIN
TERMIN
; Top level codes
TPLTAB:
TPC SE==240. ; subnegotiation end
TPC NOP==241. ; no-op
TPC DM==242. ; data mark
TPC BRK==243. ; break key
TPC IP==244. ; interrupt process
TPC AO==245. ; abort output
TPC AYT==246. ; are you there?
TPC EC==247. ; erase character
TPC EL==248. ; erase line
TPC GA==249. ; go ahead
TPC SB==250. ; subnegotiation
TPC WILL==251. ; sender will do
TPC WONT==252. ; sender won't do
TPC DO==253. ; receiver asked to do
TPC DONT==254. ; receiver must not do
TPC IAC==255. ; interpret as command
TPLMIN==400-<.-TPLTAB>
; Various WILL/WONT/DO/DONT options
WDOTAB:
TPC TRNBIN==0. ; transmit binary
TPC ECHO==1. ; echo
TPC RCP==2. ; reconnect
TPC SUPRGA==3. ; suppress GA
TPC NAMS==4. ; negotiate approx. message size
TPC STATUS==5. ; status option
TPC TIMMRK==6. ; timing mark
TPC RCTE==7. ; remote controlled trans/echo
TPC NAOL==8. ; negotiate output line width
TPC NAOP==9. ; negotiate page size
TPC NAOCRD==10. ; negotiate output CR
TPC NAOHTS==11. ; negotiate output horizontal tab stops
TPC NAOHTD==12. ; negotiate output HT
TPC NAOFFD==13. ; negotiate output FF
TPC NAOVTS==14. ; negotiate output vertical tab stops
TPC NAOVTD==15. ; negotiate output VT
TPC NAOLFD==16. ; negotiate output LF
TPC EXTASC==17. ; Tovar's cretinous idea of extended ASCII
TPC LOGOUT==18. ; logout option
TPC BM==19. ; byte macro
TPC DET==20. ; data entry terminal option
TPC SUPDUP==21. ; SUPDUP (not TELNET) protocol
TPC SDOTPT==22. ; SUPDUP output
WDOMAX==.-WDOTAB-1
EXOPL==255. ; extended options
RNDYLZ==256. ; randomly lose
;INTSER INTSR0 INTSR1 INTSR2
SUBTTL Interrupt server
; Interrupts only set flags which the main program (normally in INTW⊗
; state) looks at. Clock interrupts fake the world since it is possible
; to lose an interrupt otherwise.
INTSER: SKIPN X,JOBCNI ; get interrupt status
JRST 4,.-1
TLNN X,(INTCLK) ; clock int fakes TTI and NTI
JRST INTSR0
TLO X,(INTTTY\INTINP)
AOSN IDLTIM ; bump idle time
UNLOCK ; idle timeout; unlock
INTSR0: TLNE X,(INTTTY) ; TTI int
SETOM TTINTP
TLNE X,(INTINP) ; NTI int
SETOM NTINTP
TLNE X,(INTIMS) ; status change
SETOM CLSINP
TLNN X,(INTINR)
JRST INTSR1
SKIPE DEBUGP
OUTSTR [ASCIZ/*INR*
/]
DISMIS
INTSR1: TLNN X,(INTINS) ; IMP INS int
DISMIS
SOSL NTOINP
JRST INTSR2 ; dismiss interrupt
; Network interrupt, abort all TTY output!
IFE FTDPYP,[
MOVEI X,5*TTOBFL-1 ; reset TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[440700,,TTOBFR] ; reset TTY buffer pointer
MOVEM X,TTOPTR
SETZM X,TTOBFR ; and zap buffer while at it
MOVE X,[TTOBFR,,TTOBFR+1]
BLT X,TTOBFR+TTOBFL-1
]
INTSR2: SKIPE DEBUGP
OUTSTR [ASCIZ/*INS*
/]
DISMIS ; dismiss interrupt
;TELNET MONDLM SEMDLM SCNARG
SUBTTL Start of program
TELNET: CAI
RESET
SETZM MONCMP
IFN FTALTN,[
HRRES ARPPRI
HRRES ETHPRI
];IFN FTALTN
; Scan monitor command line.
RESCAN X
JUMPLE X,CHKTTY ; no command to scan
INCHRS
JRST CHKTTY ; goddam bagbiting lying monitor
TRZ "a#"A ; uppercaseify if necesary
CAIN "S ; maybe SUPDUP command?
JRST [ INCHRS
JRST CHKTTY ; guess not
TRZ "a#"A
CAIE "U ; SUPDUP
CAIN "D ; SD
JRST MONDLM ; SUPDUP or SD command
JRST SEMDLM] ; something else
CAIN "O ; OTN?
JRST [ SETOM OTNCMP
JRST MONDLM]
CAIE "D
CAIN "T
MONDLM: SKIPA X,[" ] ; TELNET or DTN command, scan for space
SEMDLM: MOVEI X,"; ; some other command, use semicolon
SCNARG: INCHRS
JRST CHKTTY
IFN FTALTN,[
CAIN "/
JRST [ INCHRS
JRST MISSWT ; missing switch
PUSHJ P,GLOBSW
JRST SCNARG ]
];IFN FTALTN
CAIN "? ; ? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ; something else there
OUTSTR HLPMES
JRST SCNARG]
CAIE ↑J
CAIN 175
JRST CHKTTY ; end of command line
CAIE (X)
JRST SCNARG
SETOM MONCMP
; (continued on next page)
;SCNAR1 SCNAR2 CHKTTY
; Gobble down host name from monitor command here
SETZM HSTBEG
MOVE [HSTBEG,,HSTBEG+1]
BLT HSTEND ; zak!
MOVEI X,5*HSTNLN
MOVE Y,[440700,,HSPBUF]
SCNAR1: INCHWL
CAIN "? ; ? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ; something else there
OUTSTR HLPMES
JRST SCNAR1]
CAIE <" >
CAIN ↑M
JRST SCNAR1
CAIE ↑J
CAIN 175
JRST CHKTTY
IDPB Y ; save character in buffer
SOJG X,SCNAR1
SCNAR2: INCHWL ; flush extra characters
CAIE ↑J
CAIN 175
JRST CHKTTY
JRST SCNAR2 ; what a loser
; Paw over terminal characteristics
CHKTTY: HRROI 0,[003000,,0]
TTYSET 0, ; get line characteristics
CAMN 0,[-1]
EXIT ; how can I work if detached?
IFE FTDPYP,[
SETZM DPYP ? SETZM DMDPYP
TLNE (DISLIN\DMLIN\DDDLIN) ; display?
SETOM DPYP
TLNE (DMLIN) ; DM?
SETOM DMDPYP
HRROI [055000,,NOEDTP]
TTYSET ; get NOEDIT flag (0 or 1)
];IFE FTDPYP
SKIPN MONCMP
JRST GETHST ; not command; prompt for host
JRST GETHS1 ; no host prompt
;TOPLEV GETHST GETHS1 GETHCH FLSHEX GLOBSW
SUBTTL Top level
TOPLEV: SKIPE MONCMP ; called from monitor level?
JRST PUNT
GETHST: SETZM MONCMP ; in case called from null command
IFN FTALTN,[ ; reset switches
HRRES ARPPRI
HRRES ETHPRI
];IFN FTALTN
OUTSTR [ASCIZ/Host = /]
SETZM HSTBEG
MOVE [HSTBEG,,HSTBEG+1]
BLT HSTEND ; zak!
; Set up the world
GETHS1: RESET ; clear all I/O
MOVE JOBFF
CORE ; smallify
CAI
SETZM CORBEG
MOVE [CORBEG,,CORBEG+1]
BLT COREND ; zak!
MOVE P,[PDL(-PDLLEN)] ; set up stack pointer
OPEN DSI,[0 ? 'DSK,, ? DSIBF] ; get a disk input channel
FATAL DSK OPEN failed
OPEN DSO,[0 ? 'DSK,, ? DSOBF,,] ; get a disk output channel
FATAL DSK OPEN failed
SETACT [[ 777777,,777777 ; activate on everything
777777,,777777 ; just set it up for when we need it
777777,,777777
777777,,600000\BSACT]]
SETZM HOST
SETZM USRSKT
; Now preprocess the host name
SKIPE MONCMP
JRST GOTHST ; already set up
SETZM HSPBUF
MOVE [HSPBUF,,HSPBUF+1]
BLT HSPBUF+HSTNLN-1
MOVE Y,[440700,,HSPBUF]
MOVEI Z,5*HSTNLN
GETHCH: INCHWL X
CAIN X,775 ; αβALT is magic
PUSHJ P,DDTCAL
ANDI X,177
CAIN X,"? ; ? requests help
JRST [ SKIPE HSPBUF
JRST .+1 ; something else there
OUTSTR HLPMES
INSKIP
JRST TOPLEV
JRST GETHCH]
CAIE X,<" >
CAIN X,↑M
JRST GETHCH
CAIE X,↑J
CAIN X,175
JRST GOTHST
IDPB X,Y ; save character in buffer
SOJG Z,GETHCH
FLSHEX: INCHWL X ; flush extra characters
CAIN X,775 ; αβALT is magic
PUSHJ P,DDTCAL
ANDI X,177
CAIE X,↑J
CAIN X,175
JRST GOTHST
JRST FLSHEX ; what a loser
IFN FTALTN,[
GLOBSW: CAIE 0,"A ;ARPAnet
CAIN 0,"a
JRST [ MOVSI 0,1
HLLM 0,ARPPRI
POPJ P, ]
CAIE 0,"E ;Ethernet
CAIN 0,"e
JRST [ MOVSI 0,1
HLLM 0,ETHPRI
POPJ P, ]
OUTSTR [ASCIZ "?
Bad switch: /"]
OUTCHR 0
OUTSTR [ASCIZ/
/]
JRST GETHST
];IFN FTALTN
;GOTHST NOTNSW SKTLUZ
SUBTTL Process host specification
GOTHST: HRROI 0,[030000,,1] ; set the no-PK bit to hide input buffer
TTYSET 0,
SETZM IPHOST ; Start off assuming not IP host number
IFN 0,[ ;JJW - we don't need this anymore, do we?
MOVE HSPBUF
ANDCM [<ASCII/XXX/>#<ASCII/xxx/>]; convert cases
CAME [ASCII/NSW/] ; happy Geoff
JRST NOTNSW
MOVE [ASCII/33@SR/]
MOVEM HSPBUF
MOVE [ASCII/I-KA/]
MOVEM HSPBUF+1
NOTNSW:
];IFN 0
MOVE Y,[440700,,HSPBUF]
MOVE Z,[440700,,HNMBUF]
ILDB X,Y ; first character tells it all
IFN FTALTN,[
CAIN X,"/ ; switch?
JRST [ILDB 0,Y
PUSHJ P,GLOBSW
ILDB X,Y
JRST .+1]
];IFN FTALTN
JUMPE X,GETHST ; null JCL
CAIL X,"0
CAILE X,"9
JRST ALPHST ; alphabetic host specification
PUSHJ P,SWINIP ; get socket or host number
JUMPE X,GOTHSN ; end of spec, host number
CAIN X,"/ ; BBN style number?
JRST [ CAILE B,377
SETO B,
PUSH P,B
ILDB X,Y ; check numericness
CAIL X,"0
CAILE X,"9
JRST HSTLUZ
PUSHJ P,SWINIR
SKIPN B
SETZM (P)
POP P,A ; A←host, B←IMP
LSH B,9.
ADDI B,(A)
JRST GOTHS1]
CAIN X,"# ; XEROX style number
JRST [ SKIPLE A
CAILE A,377
JRST HSTLUZ
PUSH P,A
ILDB X,Y ; check numericness
CAIL X,"0
CAILE X,"9
JRST HSTLUZ
PUSHJ P,SWINIR
POP P,B ; B←network, A←host
SKIPLE A
CAILE A,377
JRST HSTLUZ
LSH B,8.
ADDI B,(A)
MOVEI A,NW%SU ; set network type
DPB A,[NW$BYT,,B]
JUMPE X,GOTHS2 ; if end of string, we're done
CAIE X,"#
JRST GOTHS2
ILDB X,Y ; skip over #, check for number
JUMPE X,GOTHS2 ; trailing # should be there!
CAIL X,"0 ; scan socket number
CAILE X,"9
JRST HSTLUZ
PUSH P,B
PUSHJ P,SWINIR
POP P,B
JUMPL A,SKTLUZ
MOVEM A,USRSKT
JUMPE X,GOTHS2 ; make sure this is last thing!
JRST SKTLUZ]
SKIPL A ; octal has priority over decimal
MOVE B,A
TRNN B,1 ; homosocketual connection?
SETO B,
JUMPLE B,SKTLUZ
MOVEM B,USRSKT
CAIE X,",
CAIN X,"@
JRST HSTSPC
OUTSTR [ASCIZ/Illegal character in socket number
/]
CLRBFI
JRST TOPLEV
SKTLUZ: OUTSTR [ASCIZ/Illegal socket number
/]
CLRBFI
JRST TOPLEV
;HSTSPC GOTHSN GOTHS1 GOTHS2 HSTLUZ ALPHST MISSWT
; Host specification
HSTSPC: ILDB X,Y ; first character must be numeric
JUMPE X,HSTLUZ
CAIL X,"0
CAIL X,"9
JRST ALPHST
PUSHJ P,SWINIP ; get host
GOTHSN: SKIPL A
MOVE B,A
GOTHS1: SKIPE IPHOST
JRST IPHCHK ; Check IP host number
LDB A,[330700,,B] ; check network number
CAIE A,12 ; ARPAnet = 12
SKIPN A ; local network = 0
TDNE B,[600600,,000400] ; make sure number is valid
SETZ B, ; crufty argument
GOTHS2: JUMPLE B,[ OUTSTR [ASCIZ/Illegal host number
/]
CLRBFI
JRST TOPLEV]
MOVEM B,HOST
;;; JUMPE X,GOICP ; end of spec
JUMPE X,CHKHNM ; end of spec, check host type
HSTLUZ: OUTSTR [ASCIZ/Illegal character in host number
/]
CLRBFI
JRST TOPLEV
IPHCHK: TLNE B,740000 ; Make sure number is valid
SETZ B, ; Bad IP format
JRST GOTHS2 ; Anything else might be legal someday
; Alphabetic host specification
ALPHST: IDPB X,Z ; copy spec into block for HSTNAM
JUMPE X,CHKHNM
ILDB X,Y
IFN FTALTN,[
CAIE X,"/ ; switch?
];IFN FTALTN
JRST ALPHST
IFN FTALTN,[
ILDB 0,Y
PUSHJ P,GLOBSW
ILDB X,Y
JUMPE X,CHKHNM
OUTSTR [ASCIZ/?
Single switch only, please.
/]
JRST GETHST
MISSWT: OUTSTR [ASCIZ/?
Missing switch letter.
/]
JRST GETHST
];IFN FTALTN
;CHKHNM HNUMLP HNUMEN GOTHDB NOSYS HPRILP HPRIL1 HPRIL2 HPRIL3 HPRIL4 HPRIL5
; Host name specified, ask magical routine to find it
CHKHNM: PUSHJ P,MAPHST ; bring host table in core
SKIPE HOST ; host name waiting?
JRST [ PUSHJ P,HSTNUM ; no, just try and get an HDB
CAI ; ignore unknown host
JRST GOTHDB]
MOVEI HNMBUF
PUSHJ P,HSTNAM ; get descriptor block for the host
JRST [ OUTSTR [ASCIZ/No such host.
/]
PUSHJ P,UNMHST
CLRBFI
JRST TOPLEV]
JRST [ OUTSTR [ASCIZ/Ambiguous host name.
/]
PUSHJ P,UNMHST
CLRBFI
JRST TOPLEV]
IFE FTALTN,[
MOVEM HOST
];IFE FTALTN
IFN FTALTN,[
MOVSI X,-HNUMSZ
HNUMLP: MOVEM HNUMTB(X) ; Save a network address
PUSHJ P,HSTNXA ; Get next host address
JRST HNUMEN ; No more addresses
AOBJN X,HNUMLP ; Go back for more addresses
HNUMEN: SETZM HNUMTB+1(X) ; Mark end of table
];IFN FTALTN
GOTHDB:
IFE FTALTN,[
LDB X,[NW$BYT,,HOST] ; check network type
CAIE X,NW%SU ; IF ethernet, use "old" as default
SKIPE OTNCMP
SKIPA X,[OPRSKT]
MOVEI X,NPRSKT
SKIPN ICPSKT ; use only as default
MOVEM X,ICPSKT
];IFE FTALTN
IFE FTDPYP,[
TLNN 1,-1 ; any system spec?
JRST NOSYS ; unknown system
MOVE USRSKT
CAIE NPRSKT
JUMPN 0,NOSYS ; don't flush line editor if not TELNET
HLRZ X,1
MOVE (X)
CAME [ASCII/ITS/] ; if an ITS,
NOSYS: SKIPN DPYP ; or not a display
];IFE FTDPYP
PUSHJ P,ECHATM ; use character mode
PUSHJ P,UNMHST ; flush host table
IFN FTALTN,[
MOVSI X,-HNUMSZ ;Scan host number table
HPRILP: SKIPN 1,HNUMTB(X) ;Get host number or end mark
JRST HPRIL2
LDB [NW$BYT,,1] ;Get network number from host number
MOVSI 1,-NETTSZ ;Search networks we know about
CAME NETTAB(1) ;Is this a network we know about?
AOBJN 1,.-1 ; No, forget it
MOVE NETPRI(1) ;Get priority for using this net
HPRIL1: MOVEM HPRITB(X) ;Save for sorting by priority
AOBJN X,HPRILP ;Repeat for each host address
HPRIL2: HRROM X,HPRITB(X) ;Large negative priority for last
HPRIL3: MOVSI X,-HNUMSZ ;Do one iteration of bubble sort
SETO 1, ;Presume in order
HPRIL4: MOVE HPRITB(X) ;Get first entry
CAML HPRITB+1(X) ;Is next entry higher priority
JRST HPRIL5 ; No
MOVE 1,HNUMTB(X) ;Use two ACs for side effect of setting
;AC 1 ≠ -1
EXCH HPRITB+1(X) ;Swap entries
EXCH 1,HNUMTB+1(X)
MOVEM HPRITB(X)
MOVEM 1,HNUMTB(X)
HPRIL5: SKIPE HNUMTB+1(X) ;End of table?
AOBJN X,HPRIL4 ;Repeat for each table entry
AOJN 1,HPRIL3 ;Start again if at least one swap
];IFN FTALTN
;⊗ GOICP GOICP0 GOIC0A GOICP1 ICPFAI NOICP GOICP2 NOTPUP NOTPRT GOICP3 GOICP4
SUBTTL ICP ICP ICP
GOICP: PTJOBX [0 ? 3] ; local echo off
IFN FTALTN,[
MOVSI X,-HNUMSZ ; setup for list of addresses to try
SKIPE 1,HOST ; is there an explicit address?
TDZA X,X ; yes
GOICP0: MOVE 1,HNUMTB(X)
JUMPE 1,NOICP
MOVEM 1,HOST
HLRE 0,HPRITB(X) ; is host accessible
AOJL 0,NOICP ; no
LDB 0,[NW$BYT,,HOST] ; See if it's TN/A to Ethernet host
HLRZ 1,ARPPRI
CAIN 1,1 ; /A switch?
CAIE 0,NW%SU ; Ethernet?
JRST GOIC0A ; No to one or the other
SETOM IPHOST ; Tell CONECT not to convert
MOVE 0,HOST
PUSHJ P,H2TOIP ; Make into IP host number
SETZM IPHOST ; Conversion failed?
MOVEM 0,HOST
GOIC0A: OUTSTR [ASCIZ/ Trying /]
LDB 0,[NW$BYT,,HOST] ; check network type
MOVSI 1,-NETTSZ
GOICP1: CAMN 0,NETTAB(1)
OUTSTR @NETNAM(1)
AOBJN 1,GOICP1
OUTSTR [ASCIZ/... /]
CAIE 0,NW%SU ; IF ethernet, use "old" as default
SKIPE OTNCMP
SKIPA 1,[OPRSKT]
MOVEI 1,NPRSKT
SKIPE USRSKT ; use only as default
MOVE 1,USRSKT
MOVEM 1,ICPSKT
XCT CONECT ; let's take our own errors
JRST [PUSHJ 17,MTPERR ? JRST ICPFAI]
JRST [PUSHJ 17,NIOERR ? JRST ICPFAI]
JRST GOICP2
ICPFAI: SKIPE HNUMTB+1(X)
AOBJN X,GOICP0 ; check for another
NOICP: SKIPN HOST ; did we try even once?
OUTSTR [ASCIZ/Host not directly accessible.
/] ; no
EXIT 1,
JRST GETHST
GOICP2: SETZM NPROTP
MOVE 0,ICPSKT ; for check below
CAIN 0,NPRSKT
SETOM NPROTP ; using new protocol
];IFN FTALTN
IFE FTALTN,[
OUTSTR [ASCIZ/ Trying... /]
SETZM NPROTP
MOVE ICPSKT ; for check below
CAIN NPRSKT
SETOM NPROTP
PUSHJ P,CONECT ; call wonderful ICPer
];IFE FTALTN
OUTSTR [ASCIZ/Open
/]
MOVEI 1 ; get type of connection
PNAME 0,
SETZ 0,
MOVSS 0
SKIPN NPROTP ; old protocol PUP connection?
CAIE 'PUP
JRST NOTPUP ; not PUP or else new protocol
SETOM CRONLY ; yes, sigh...
SETOM ECHOP
NOTPUP:
IFN FTDPYP,[
PUSHJ P,DPYINI ; init the dpy screen
PUSHJ P,CLRSCN
];IFN FTDPYP
; Initialize interrupts
MOVEI INTSER
MOVEM JOBAPR ; set up interrupt server
CLKINT 60.*CLKSPD ; start the ticking clock
MOVSI (INTTTY\INTCLK\INTINS\INTINR\INTIMS\INTINP)
INTENB ; enable interrupts
; Random other initialization
MOVNI LOKTMO
MOVEM IDLTIM ; initialize lock timeout
LOCK ; prevent swapouts
IFE FTDPYP,[
SKIPE DPYP
JRST NOTPRT
PUSHJ P,ETRANS ; enter transparent mode
];IFE FTDPYP
; If new protocol, flush cretin GA's (we refuse to implement 'em) and try to
; get local echoing.
NOTPRT: SKIPN NPROTP ; new protocol?
JRST GOICP4 ; may be an FTP or something
SNEAKS
JRST GOICP3
CAIN 700 ; if αβ@ typed ahead
SETOM DEBUGP ; MRC is fooling around!
GOICP3:
IFE FTDPYP,[
TELCMD [IAC DO ECHO IAC DO SUPRGA]
];IFE FTDPYP
IFN FTDPYP,[
TELCMD [IAC DO ECHO IAC DO SUPRGA IAC WILL TRNBIN]
];IFN FTDPYP
SETOM ECHOP ? SETOM SUPGAP
; Initialize TTY output buffer variables and randomness
GOICP4:
IFE FTDPYP,[
MOVEI 5*TTOBFL-1 ; set up TTY buffer counter
MOVEM TTOCTR
MOVE [440700,,TTOBFR] ; set up TTY buffer pointer
MOVEM TTOPTR
SETZM TTOBFR
MOVE [TTOBFR,,TTOBFR+1]
BLT TTOBFR+TTOBFL-1
];IFE FTDPYP
INSKIP
JRST SLEEPR
SETOM TTINTP
; (continued on next page)
;SLEEPR SLEPRX SLEPR1 GETDCH SNCH CONERR
SUBTTL Main program loop
SLEEPR: SKIPL INPFLP ; unless input file open,
SLEPRX: IWAIT ; sleep for an interrupt
SLEPR1: AOSG TTINTP ; TTY int?
JRST TTISER
SKIPN CLSINP ; if closing, keep trying input till lossage
AOSG NTINTP ; NTI int?
JRST NTISER
SKIPL INPFLP ; input file open?
JRST SLEEPR
MOVEI 16 ; get allocations
MTAPE NET,
JUMPE 7,SLEPRX ; if out of bit
JUMPE 10,SLEPRX ; or message allocation, must wait!
GETDCH: SOSG DSIBF+2
IN DSI,
CAIA
JRST [ CLOSE DSI,
PUSHJ P,NETSND
OUTSTR [ASCIZ/End of input file /]
MOVE X,INPFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,INPEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,INPPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,INPPPN
PUSHJ P,OUTSIX ;matching '['
OUTSTR [ASCIZ/].
/]
SETZM INPFLP
JRST SLEEPR]
ILDB DSIBF+1
JUMPE GETDCH
; Semi-duplicate of TTYSER's CHRHAK
IFE FTDPYP,[
SKIPN ECHOP ; echo if in local mode
OUTCHR
];IFE FTDPYP
IFN FTDPYP,[
SKIPE ECHOP
JRST SNCH
PUSH P, ? PUSHJ P,DCHOUT ? PUSHJ P,SCNUPD ? POP P,
SNCH:];IFN FTDPYP
; Canonicalize from SAIL to standard ASCII
CAIN 33 ; control-Z
JRST [MOVEI 32 ↔ JRST CANON]
CAIN 175 ; ALT
MOVEI 33 ;{
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
CANON:
; Here to actually send the character
PUSHJ P,NETOCH ; output the character
SKIPE SLOWFP ; nice slow file processing?
PUSHJ P,NETSND ; yah, force on every character
JRST SLEPR1
; Here if connection is losing
CONERR: SKIPE CLSINP ; not closing?
SKIPE ISLURP ; error in slurping?
IFE FTDPYP,JRST TOPLEV ; yes, back to top level
.ELSE JRST SCRFIX ; but fix the screen first dear
JRST NTISER ; no, start slurping
;TTISER TTISR4 TTISR2 HAKCOM
SUBTTL TTY input interrupt
TTISER: INCHSL ; get a character
JRST [ AOSG NTBFOP ; anything in the buffer?
PUSHJ P,NETSND ; force it out
AOSG NTINTP ; TTI buffer empty
JRST NTISER ; but some net stuff to handle
JRST SLEEPR]
SKIPL IDLTIM
LOCK
MOVNI 1,LOKTMO
MOVEM 1,IDLTIM ; reset idle time
; Command and mapping stuff. We only map between our character set and
; ASCII. Anybody who wants mapping to MIT's character set should use SUPDUP!!
IFE FTDPYP,[
SKIPE TRANSP ; ↑↑ processing if transparent
JRST TTISR4
LDB 1,[000700,,]
CAIN 1,↑M
INCHRW 1 ; flush LF after CR
JRST TTISR2
TTISR4: ANDCMI 400 ; zap image-mode bit
SKIPN NOEDTP ; skip if noedit display -- flush parity bit
SKIPN DMDPYP ; skip if DM-type display (has edit key)
ANDI 177 ; flush the parity bit (no EDIT key)
CAME ESCHAR
JRST CHRHAK ; not escape character
INCHRW
ANDCMI 400 ; turn off image-mode bit
SKIPN NOEDTP ; skip if noedit display -- flush parity bit
SKIPN DMDPYP ; skip if DM-type display (has edit key)
ANDI 177 ; flush the parity bit (no EDIT key)
CAMN ESCHAR ; escape quotes itself
JRST CHRHAK ; send esc char itself
ANDCMI 200 ; clear EDIT bit
CAIE "- ; command off?
JRST TTYSR5 ; no, this is cmd char, do positive cmd (β-char)
INCHRW ; yes, get cmd char
TROA 600 ; form αβcharacter
TTYSR5: IORI 400 ; form βcharacter
TTISR2:
];IFE FTDPYP
CAIN 775 ; αβALT is magic
PUSHJ P,DDTCAL
IFN FTDPYP,[
CAIN 600\↑L ; αβFORM is like META
JRST [ INCHRW
JRST HAKCOM]
CAIE 600\↑K ; αβVT is like CONTROL-META
JRST CHRHAK
INCHRW
IORI 200
HAKCOM:
];IFN FTDPYP
.ELSE [
CAIN 777 ; αβBS?
JRST [ MOVEI 177 ? JRST TTISR1]; just an ordinary character
TRZN 400 ; META set?
JRST [ TRZN 200 ; if CONTROL is set
JRST CHRHAK ; output it, but map
ANDI 37 ; convert to canonical ASCII control
JRST TTISR1] ; never map if we controllified!
];IFN FTDPYP
LDB X,[000700,,0] ; get ASCII part
CAILE X,"←
SUBI X,"a-"A ; uppercaseify if necessary
SUBI X,"@
JUMPL X,NTISER ; no op character
TRNN 200 ; CONTROL?
SKIPA X,CMCDSP(X) ; no, use right half
HLR X,CMCDSP(X) ; yes, use left half
PUSHJ P,(X)
JRST TTISER
;CHRHAK CHRHK0 CHRHK2 CHRHK1 TTISR1 TTISR9 TTISR3
; Here only if an ASCII printing character
CHRHAK:
IFE FTDPYP,[
SKIPE ECHOP ; echo if in local mode
JRST CHRHK0
OUTCHR
SKIPL OUTFLP ; output file in progress?
JRST CHRHK0
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
CHRHK0:
; Canonicalize from SAIL to standard ASCII
SKIPE TRANSP ; no canonicalization need if transparent
JRST [ SKIPN TRBINP ; if not binary mode
ANDCMI 200 ; flush edit bit
JRST TTISR1]
CAIN 175 ; ALT
MOVEI 33
CAIN 176 ; }
MOVEI 175
CAIN 32 ; ~
MOVEI 176
];IFE FTDPYP
IFN FTDPYP,[
SKIPE ECHOP
JRST CHRHK2
PUSH P, ? PUSHJ P,DCHOUT ? PUSHJ P,SCNUPD ? POP P,
CHRHK2: LDB 1,[000700,,] ; get only ASCII part of character
CAIN 1,↑M
JRST [ INCHRW ; oops, line feed lossage
JRST CHRHK1] ; so the CR has the right bucky bits
CAIN 1,175
JRST [ MOVEI 1,33 ; ALT
JRST CHRHK1]
CAIN 1,176 ; }
MOVEI 1,175
CAIN 1,32 ; ~
MOVEI 1,176
CAIN 1,33 ; ≠
MOVEI 1,32
CHRHK1: DPB 1,[000700,,]
TRZE 200 ; if CONTROL is set
TRZ 140 ; convert to canonical ASCII control
TRZE 400 ; and for META
IORI 200 ; set EDIT
];IFN FTDPYP
; Here to actually send the character
TTISR1: PUSHJ P,NETOCH ; output the character
SETOM NTBFOP ; flag there is network output
CAIN IAC ; IAC must be doubled
SKIPN NPROTP ; but not in old protocol.
SKIPA
JRST TTISR3
SKIPE TRBINP ; don't consider CR's if binary mode
JRST TTISER
CAIN ↑M
TRCA ↑J#↑M ; finish off new line
JRST TTISER
IFE FTDPYP,[
SKIPE ECHOP ; echo right on printing terminals
JRST TTISR9
OUTCHR
SKIPL OUTFLP ; output file in progress?
JRST TTISR9
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
];IFE FTDPYP
IFN FTDPYP,[
SKIPE ECHOP
JRST TTISR9
PUSH P, ? PUSHJ P,DCHOUT ? PUSHJ P,SCNUPD ? POP P,
];IFN FTDPYP
TTISR9: SKIPN CRONLY ; only sending CR's without LF's
TTISR3: PUSHJ P,NETOCH
JRST TTISER
;NTISER NTISR2 NTISR4
SUBTTL Network input interrupt
NTISER: SKIPE CLSINP ; closing?
JRST [ SKIPN ISLURP ; in slurp mode?
JSP X,[SETOM ISLURP ; tell CONERR we are slurping
IFE FTDPYP,OUTSTR TTOBFR
.ELSE PUSHJ P,SCNUPD
JRST (X)]
PUSHJ P,NETICW ; slurp slurp slurp
JRST NTISR2]
AOSG TTINTP
JRST [ SETOM NTINTP ; make sure we come back here
JRST TTISER] ; give the TTY a chance!
PUSHJ P,NETICH ; get a character
IFN FTDPYP,[
JRST [ PUSHJ P,SCNUPD
JRST SLEEPR]
];IFN FTDPYP
.ELSE [ JRST [ OUTSTR TTOBFR
MOVEI 5*TTOBFL-1 ; reset TTY buffer counter
MOVEM TTOCTR
MOVE [440700,,TTOBFR] ; reset TTY buffer pointer
MOVEM TTOPTR
SETZM TTOBFR
MOVE [TTOBFR,,TTOBFR+1]
BLT TTOBFR+TTOBFL-1
AOSG TTINTP
JRST TTISER ; TTI int to be taken care of
JRST SLEEPR] ; else sleep
];IFE FTDPYP
SKIPL IDLTIM
LOCK
MOVNI 1,LOKTMO
MOVEM 1,IDLTIM ; reset idle time
; Hack protocol commands
NTISR2: SKIPN NPROTP ; old protocol?
TRNN 600 ; command?
JRST NTISR4 ; new protocol or not a command
CAIE 200 ; old TELNET DM
CAIN 401 ; pup TELNET DM
AOS NTOINP
CAIN 203
SETOM ECHOP
CAIN 204
SETZM ECHOP
CAIN 405 ; pup TELNET timing mark?
JRST NTISR8 ; yes, send stupid reply
;Don't look at IAC for PARC's Ethernet TELNET. If it's in this mode, it
;isn't going to know this, and it's a probably a VAX EMACS trying to be
;'10 EMACS and mistakenly echoing a word-delete command (e.g. Meta-Delete).
SKIPN CRONLY ;Don't even try new protocol if CRONLY
CAIE IAC
JRST NTISER ; otherwise some random old command
NTISR4: AOSG NETCMP ; IAC in progress?
JRST IACSER
IRPS OPT,,WILL WONT DO DONT
AOSG OPT!P
JRST OPT!SR
TERMIN
CAIN IAC ; network command?
JRST [ SETOM NETCMP ; remember that one is coming
SETOM NPROTP
JRST NTISER]
; (continued on next page)
;NTISR1 NTIS1A NTISR6 NTISR5 NTISR3 NTISR7 NTISR8
; Hack character for output
NTISR1: IFE FTDPYP,[
SKIPE TRANSP ; no canonicalization needed if transparent
JRST NTIS1A
JUMPE NTISER ; flush nulls
CAIN 176 ; ~
MOVEI 32
CAIN 175 ; }
MOVEI 176
CAIN 33 ; diamond
MOVEI 175
CAIN ↑G
JRST [ SETO
BEEP
JRST NTISER] ; map bells to bells
CAIN 177 ; rubout is usually padding
JRST NTISER
];IFE FTDPYP
NTIS1A: SKIPGE NTOINP ; no output if still output reset
JRST NTISR3
SKIPE ISLURP
IFN FTDPYP,[
JRST [ PUSH P,
PUSHJ P,DCHOUT
PUSHJ P,SCNUPD
POP P,
JRST NTISR3]
PUSH P,
PUSHJ P,DCHOUT
POP P,
];IFN FTDPYP
IFE FTDPYP,[
JRST [ OUTCHR ; slurp mode can't buffer
JRST NTISR3] ; since it can die at any time!
TRNE 0,177 ; nulls can't be outstr'd, skip if null
TRNE 0,200 ; nor can chars with parity bit set
JRST NTISR6 ; so must use OUTCHR
SOSLE TTOCTR ; buffer stuffed?
JUMPN NTISR5 ; no, put new byte in unless null
NTISR6: OUTSTR TTOBFR ; type out all previous text
MOVEI X,5*TTOBFL-1 ; set up TTY buffer counter
MOVEM X,TTOCTR
MOVE X,[440700,,TTOBFR] ; set up TTY buffer pointer
MOVEM X,TTOPTR
SETZM TTOBFR
MOVE X,[TTOBFR,,TTOBFR+1]
BLT X,TTOBFR+TTOBFL-1
TRNE 0,177 ; nulls can't be outstr'd
TRNE 0,200 ; nor can chars with parity bit set
JRST [AOS TTOCTR ; bump pointer back up by one
OUTCHR 0 ; output funny char (maybe transparent mode)
JRST NTISR3]
NTISR5: IDPB TTOPTR
];IFE FTDPYP
NTISR3: SKIPL OUTFLP ; output file in progress?
JRST NTISR7
SOSG DSOBF+2
OUTPUT DSO,
IDPB DSOBF+1
NTISR7:
;;; This should be needed, but isn't???
;;; SKIPE CRONLY ; do we need to supply a LF
;;; CAIE ↑M ; after a CR?
JRST NTISER ; no
IFE FTDPYP,[
SKIPE TRANSP ; watch out for transparent mode!
JRST NTISER
];IFE FTDPYP
MOVEI ↑J ; fake a LF
JRST NTISR1
;Send timing mark reply for old style PUP (sigh...)
NTISR8: MTAPE 1,SMRBLK ; yes, send Timing Mark Reply
JFCL ; ignore error, interrupt code should see it
JRST NTISER
;IACSER TPLMSG OPTMSG RNDMSG
SUBTTL IAC service
IACSER: CAIN IAC ; quoted IAC?
JRST NTISR1 ; just send it
SKIPE DEBUGP
PUSHJ P,TPLMSG
CAIN DM ; data mark?
JRST [ AOS NTOINP
JRST NTISER]
IRPS OPT,,WILL WONT DO DONT
CAIN OPT
JRST [SETOM OPT!P
JRST NTISER]
TERMIN
CAIN SB
WARN Foreign host sent a subnegotiation
JRST NTISER ; not an option I know
; Protocol command message for MRC's fooling around
TPLMSG: OUTSTR [ASCIZ/*IAC /]
CAIGE TPLMIN ; big enough?
JRST @RNDMSG
MOVE 1,
OUTSTR @TPLTAB-TPLMIN(1)
CAIGE WILL
OUTSTR [ASCIZ/*
/]
POPJ P,
; WILL/WONT/DO/DONT option message for MRC's fooling around
OPTMSG: CAIN EXOPL
JRST [ OUTSTR [ASCIZ/ EXOPL*
/]
POPJ P,]
OUTCHR [" ]
CAILE WDOMAX
RNDMSG: JRST [ IDIVI 100
ADDI "0
OUTCHR
IDIVI 1,10
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
OUTSTR [ASCIZ/*
/]
POPJ P,]
MOVE 1,
OUTSTR @WDOTAB(1)
OUTSTR [ASCIZ/*
/]
POPJ P,
;WILLSR WILBAD WONTSR
; IAC WILL/WONT
WILLSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN ; binary from host
JRST [ SKIPE RCBINP ; catch protocol loops
JRST NTISER
SETOM RCBINP
TELCMD [IAC DO TRNBIN]
JRST NTISER]
CAIN ECHO ; remote echo (what a win!)
JRST [ SKIPE ECHOP ; catch protocol loops
JRST NTISER
SETOM ECHOP
TELCMD [IAC DO ECHO]
JRST NTISER] ; command, we always accept it
CAIN SUPRGA ; suppress GA?
JRST [ SKIPE SUPGAP ; command or reply?
JRST NTISER
SETOM SUPGAP
TELCMD [IAC DO SUPRGA]
JRST NTISER]
CAIN LOGOUT
SKIPN MORTLP
JRST WILBAD
JRST NTISER
; Not an option we like, refuse it
WILBAD: PUSH P,
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗IAC DONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI DONT
PUSHJ P,NETOCH
POP P,
SKIPE DEBUGP
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NTISER
WONTSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN
JRST [ SKIPN RCBINP
JRST NTISER
SETZM RCBINP
TELCMD [IAC DONT TRNBIN]
JRST NTISER]
CAIN ECHO
JRST [ SKIPN ECHOP
JRST NTISER
SETZM ECHOP ; back to lossage
TELCMD [IAC DONT ECHO]
JRST NTISER]
CAIN SUPRGA
SKIPL SUPGAP
JRST NTISER ; protocol violator
SETZM SUPGAP
TELCMD [IAC DONT SUPRGA]
JRST NTISER ; loser
;DOSR DONTSR
; IAC DO/DONT
DOSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN ; binary to host
JRST [ SKIPE TRBINP ; catch protocol loops
JRST NTISER
SETOM TRBINP
TELCMD [IAC WILL TRNBIN]
JRST NTISER]
CAIN TIMMRK ; silly Multix and Tenex cretinism?
JRST [ TELCMD [IAC WILL TIMMRK]
JRST NTISER] ; yes, make the losers happy
; Not an option we like, refuse it
PUSH P,
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗IAC WONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI WONT
PUSHJ P,NETOCH
POP P,
SKIPE DEBUGP
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NTISER
DONTSR: SKIPE DEBUGP
PUSHJ P,OPTMSG
CAIN TRNBIN
SKIPN TRBINP
JRST NTISER
SETZM TRBINP
TELCMD [IAC WONT TRNBIN]
JRST NTISER
;DCHOUT DCHCKY DCHSND DCHPRT CPOPJ
SUBTTL Datamedia simulator
IFN FTDPYP,[ ;Whole page
DCHOUT: ANDI 177 ; flush buckies
AOSN GETXPP
CAIGE <" > ; controls abort
JRST DCHCKY
XORI 140
CAMLE HSIZE
SETZ
MOVEM XPOS
SETOM GETYPP
POPJ P,
DCHCKY: AOSN GETYPP
CAIGE <" >
JRST DCHSND ; real character to print
XORI 140
CAMLE VSIZE
SETZ
HRL XPOS ; make cursor position for CSRPOS
JRST CSRPOS
DCHSND: CAIN 177
MOVEI "⊗ ; random substitution for rubout
; (conveniently a no-op)
CAIN 176 ; ~
JRST [MOVEI 32 ? JRST SCSTOR]
CAIN 175 ; }
MOVEI 176
IFN FTDPYP&2,[
AOSG ESCMOD ; processing escape sequence?
JRST ESCONT ; yes, parse the fool thing
];IFN FTDPYP&2
IFE FTDPYP&2,[
AOSE QUOTEP
];IFE FTDPYP&2
CAIL <" > ; if a printing character,
DCHPRT: JRST [CAIN 32
MOVEI 33 ; sad but necessary conversion
SETZM CRP ; flush CR hacking
SKIPN INSDLP ; if not i/d
JRST SCSTOR ; store it on the screen
PUSH P,
MOVEI 1 ? PUSHJ P,INSCHR; insert character
POP P, ? JRST SCSTOR]
MOVE 1,
XCT DMCTAB(1)
CPOPJ: POPJ P,
];IFN FTDPYP
;DMCTAB
IFN FTDPYP,[ ;Whole page
DMCTAB: CAI ; ↑@ no-op
CAI ; ↑A no-op
JRST [SETZ ? JRST CSRPOS] ; ↑B home up
CAI ; ↑C no-op
CAI ; ↑D no-op
CAI ; ↑E no-op
CAI ; ↑F no-op
JRST [SETO ? BEEP ? POPJ P,] ; ↑G bell
JRST [ SKIPN INSDLP
JRST CSRSOS
MOVEI 1 ? JRST DELCHR] ; ↑H backspace | delete character
JRST CSRTAB ; ↑I tab
JRST [ SKIPE INSDLP
JRST [MOVEI 1 ? JRST INSLIN]
AOSE CRP
JRST LINEFD
POPJ P,] ; ↑J line feed | insert line
CAI ; ↑K no-op
SETOM GETXPP ; ↑L set cursor position
JRST [SETOM CRP ? PUSHJ P,CARRET ? JRST LINEFD]; ↑M move to BOL
CAI ; ↑N no-op
CAI ; ↑O no-op
SETOM INSDLP ; ↑P i/d mode on
CAI ; ↑Q no-op
CAI ; ↑R no-op
CAI ; ↑S no-op
CAI ; ↑T no-op
CAI ; ↑U no-op
CAI ; ↑V no-op
JRST CLREOL ; ↑W clear to end of line
JRST [SETZM INSDLP ? SETZM ROLLP ? POPJ P,]; ↑X cancel
CAI ; ↑Y no-op
JRST [ SKIPN INSDLP
JRST LINSRV
MOVEI 1 ? JRST DELLIN] ; ↑Z line starve | delete line
JRST GOTESC ; ↑[ quote next character or ANSI ESC
JRST [ SKIPN INSDLP
JRST CSRAOS
MOVEI 1 ? JRST INSCHR] ; ↑\ forespace | insert character
SETOM ROLLP ; ↑] scroll on
JRST [SETZM INSDLP ? JRST CLRSCN]; ↑↑ master clear
JRST [SETZM INSDLP ? JRST CLRSCN]; ↑← erase screen
GOTESC:
IFN FTDPYP&2,[
SETOM ESCMOD ; Perhaps quote next character
SETZM ARGC ; No arguments yet
SETZM ARGV
];IFN FTDPYP&2
IFE FTDPYP&2,[
SETOM QUOTEP ; quote next character
];IFE FTDPYP&2
POPJ P,
];IFN FTDPYP
;ESCONT ESCL1 ESCL2 BADESC
SUBTTL ANSI "Standard" display (+ some VT-100 stuff)
IFN FTDPYP&2,[
ESCONT: SKIPN 1,ARGV ;We'll need this sooner or later...
MOVEI 1,1
EXCH 1 ;Argument in 0, character in 1
MOVEM 1,LSTESC ;Remember for iteration and debugging
CAIL 1,"@ ;Is this one we have a table for?
CAILE 1,"P
JRST ESCL2
SETZM ESCMOD ;Leave this mode.
ESCL1: XCT ESCTB1-"@(1) ;Routine does POPJ if done.
SOSG ARGV ;More to do?
POPJ P, ; No, done
MOVE 1,LSTESC ;Restore character
JRST ESCL1 ;Try for more.
ESCL2: CAIN 1,"[ ;New standard? (Matching "])
JRST [ HRROM 1,ESCMOD ; Yes, special treatment (make large
POPJ P,] ; neg. number, value not critical)
CAIN 1,"; ;Separator?
JRST [ SKIPL ESCMOD ;Better be in long mode
JRST BADESC ; Sorry, Charlie
AOS 1,ARGC
CAIL 1,ARGMAX ;Watch for overflow
SOS ARGC ; Keep it dirty but honest
SETZM ARGV(1) ;Default assumption
POPJ P,]
CAIL 1,"0
CAILE 1,"9
JRST BADESC
SKIPGE ESCMOD ;Long form?
JRST [ MOVEI -"0(1) ; Yes, accumulate argument(s)
MOVE 1,ARGC
EXCH ARGV(1)
IMULI 12 ;Decimal?!!
ADDM ARGV(1)
POPJ P,]
SETZM ESCMOD ;Leave this mode.
; XCT ESCTB2-"0(1)
; POPJ P,
jrst badesc
;Here we have a bad escape sequence. Put this stuff on the page printer if
;in debug mode
BADESC: SETZM ESCMOD ;Leave this mode.
SKIPN DEBUGP ;Looking at lossage?
POPJ P, ; No, just ignore.
OUTSTR [ASCIZ/Bad <ESC>/]
SKIPGE ESCMOD
OUTSTR [ASCIZ/[.../] ;] for balance
OUTCHR 1
OUTSTR [ASCIZ/ /]
POPJ P,
];IFN FTDPYP&2
;ESCTB1
;Tables for ANSI mode
IFN FTDPYP&2,[ ;Whole page
;These things JRST when they don't wanted to be repeated by ARGV
ESCTB1: JRST INSCHR ;@ ICH Insert Character
PUSHJ P,LINSRV ;A CUU Cursor Up
PUSHJ P,LINEFD ;B CUD Cursor Down
PUSHJ P,CSRAOS ;C CUF Cursor Forward
PUSHJ P,CSRSOS ;D CUB Cursor Backward
PUSHJ P,[PUSHJ P,CARRET ;E CNL Cursor Next Line
MOVNI 1,"E-"B
ADDB 1,LSTESC
PUSHJ P,LINEFD
POPJ P,]
PUSHJ P,[PUSHJ P,CARRET ;F CPL Cursor Previous Line
MOVNI 1,"F-"C
ADDB 1,LSTESC
PUSHJ P,LINSRV
POPJ P,]
PUSHJ P,[PUSHJ P,CARRET ;G CHA Cursor Horizonal Absolute
MOVNI 1,"G-"C
ADDB 1,LSTESC
POPJ P,]
JRST [ SKIPE 0 ;H CUP Cursor Position
SUBI 0,1
SKIPE ARGC
HRL ARGV+1
TLNE 0,-1
SUB 0,[1,,0]
JRST CSRPOS]
PUSHJ P,CSRTAB ;I CHT Cursor Horizonal Tabulation
JRST CLREOF ;J ED Erase in Display
JRST CLREOL ;K EL Erase in Line
JRST INSLIN ;L IL Insert Line
JRST DELLIN ;M DL Delete Line
JRST BADESC ;N EF Erase in Field
JRST BADESC ;O EA Erase in Area
JRST DELCHR ;P DCH Delete Character
];IFN FTDPYP&2
;CMCDSP
SUBTTL Command dispatch
; Command dispatch table
CMCDSP: REPEAT 40,[NTISER,,NTISER ? ] ; default to no-op
DEFINE CMDCHR CHR,CDISP,DISP
LOC CMCDSP+"CHR-"@
CDISP,,DISP
TERMIN
; Command dispatch table. All routines are assumed to return via POPJ P,
; CMDCHR character,αβdispatch,βdispatch
CMDCHR @,DBUG,NDBUG ; MRC fooling around
CMDCHR A,ATTN,ATTN ; send ATTN
CMDCHR B,BREAK,BREAK ; send BRK
CMDCHR C,CLSCON,CLSCON ; close connection
CMDCHR D,CLSOFL,OPNOFL ; output file
CMDCHR E,RECHO,LECHO ; echo mode
CMDCHR F,APPEND,DAPPND ; append file
CMDCHR I,CLSIFL,OPNIFL ; input file
CMDCHR J,EOFF,EON ; echo diddle without telling host
CMDCHR K,KJOB,KJOB ; kill remote job
CMDCHR L,ECHATM,LCHATM ; line editor diddle
CMDCHR O,ABORTO,ABORTO ; abort output
CMDCHR Q,PUNT,PUNT ; exit
CMDCHR R,CLSIFL,OPNIFS ; open file in nice slow way
IFE FTDPYP,CMDCHR T,LTRANS,ETRANS ; transparent mode
CMDCHR W,RUTHER,RUTHER ; are you there?
IFE FTDPYP,CMDCHR X,ESCSET,ESCSET ; set escape character
LOC CMCDSP+40
;ATTN BREAK ABORTO RUTHER KJOB RECHO LECHO EOFF EON
SUBTTL Command service routines
; Send ATTN
ATTN: SKIPE DEBUGP
OUTSTR [ASCIZ/⊗INS*
/]
PUSHJ P,NETINS ; send INS
SKIPN NPROTP
JRST [ TELCMD [201 200]
POPJ P,]
TELCMD [IAC IP IAC DM] ; and data mark
POPJ P,
; Send break
BREAK: SKIPN NPROTP
POPJ P,
TELCMD [IAC BRK]
POPJ P,
; Send abort output
ABORTO: SKIPN NPROTP
POPJ P,
CLRBFO
SKIPE DEBUGP
OUTSTR [ASCIZ/⊗INS*
/]
PUSHJ P,NETINS
TELCMD [IAC AO IAC DM]
POPJ P,
; Send are you there
RUTHER: SKIPN NPROTP
POPJ P,
TELCMD [IAC AYT]
POPJ P,
; Logout
KJOB: SKIPN NPROTP
POPJ P,
SETOM MORTLP
TELCMD [IAC DO LOGOUT]
POPJ P,
; Enter remote echo mode
RECHO: SKIPE ECHOP
POPJ P,
SETOM ECHOP
SKIPN NPROTP
JRST [ TELCMD [204]
POPJ P,]
TELCMD [IAC DO ECHO]
POPJ P,
; Enter local echo mode
LECHO: SKIPN ECHOP
POPJ P,
SETZM ECHOP
SKIPN NPROTP
JRST [ TELCMD [203]
POPJ P,]
TELCMD [IAC DONT ECHO]
POPJ P,
; Echo diddle without asking host
EOFF: SETOM ECHOP ? POPJ P,
EON: SETZM ECHOP ? POPJ P,
;ECHATM LCHATM CLSCON SCRFIX PUNT DBUG NDBUG
; More commands
; Enter character-at-a-time mode
ECHATM: SETOM CHARMP
HRROI [001000,,(SPCBRK)]
TTYSET ; enter special activation mode
POPJ P,
; Leave character-at-a-time mode
LCHATM: SETZM CHARMP
HRROI [002000,,(SPCBRK)]
TTYSET ; leave special activation mode
POPJ P,
; Close connection
CLSCON: PUSHJ P,CLOSER ; close network connection
PUSHJ P,CLSOFL ; close output file
SETZM MONCMP ; forget being a monitor command
IFE FTDPYP,[
MOVE [-2,,[012000,,10 ? 004000,,"P]]
SKIPE TRANSP
TTYSET ; leave image mode and do [ESCAPE]P
];IFE FTDPYP
IFN FTDPYP,[
SCRFIX: HRROI [004000,,400\"N] ; [BREAK]N
TTYSET
];IFN FTDPYP
JRST TOPLEV
; Go away
PUNT:
IFE FTDPYP,[
MOVE [-2,,[012000,,10 ? 004000,,"P]]
SKIPE TRANSP
TTYSET ; leave image mode and do [ESCAPE]P
];IFE FTDPYP
IFN FTDPYP,[
HRROI [004000,,400\"N] ; [BREAK]N
TTYSET
];IFN FTDPYP
MOVE 0,[-2,,[ 010000,,0 ;Disable αCR
030000,,0]] ;Re-enable PK of input buffer
TTYSET 0, ;Execute 2 functions above
EXIT
; MRC fooling around
DBUG: SETOM DEBUGP ? POPJ P,
NDBUG: SETZM DEBUGP ? POPJ P,
;ETRANS LTRANS ESCSET
; Non-display commands
IFE FTDPYP,[
; Enter transparent mode
ETRANS: SKIPE DPYP ; DD's and III's can't be transparent
SKIPE DMDPYP ; DM's can be transparent
CAIA
POPJ P,
SETOM TRANSP
HRROI [011000,,10]
TTYSET ; enter image mode
SKIPN DMDPYP
POPJ P, ; not a DM
SKIPE NOEDTP ; skip unless noedit display
TDZA 0,0 ; no EDIT key, make [NULL] the escape char
MOVEI 200 ; make <EDIT>[NULL] the escape character
MOVEM ESCHAR
SKIPN TRBINP
SKIPN NPROTP
JRST [SKIPE CRONLY ; old protocol or in the mode already
SETOM TRBINP ; in PARC Ethernet TELNET, 200 bit
; isn't used for commands, so is safe.
POPJ P,]
SETOM TRBINP ; diddle the EDIT key
TELCMD [IAC WILL TRNBIN]
POPJ P,
; Leave transparent mode
LTRANS: SKIPN TRANSP
POPJ P,
SETZM TRANSP
MOVE [-2,,[012000,,10 ? 004000,,"P]]
TTYSET ; leave image mode and do [ESCAPE]P
SKIPE TRBINP
SKIPN DMDPYP
POPJ P, ; not a DM or not in the mode
SKIPN NPROTP
POPJ P,
SETZM TRBINP ; diddle the EDIT key
TELCMD [IAC WONT TRNBIN]
POPJ P,
; Set escape character
ESCSET: INCHRW
ANDI 377 ;flush the image mode bit
SKIPN NOEDTP ;skip if noedit display -- flush parity bit
SKIPN DMDPYP
ANDI 177 ;flush the parity bit (no EDIT key)
MOVEM ESCHAR
POPJ P,
];IFE FTDPYP
;APPEND DAPPND
SUBTTL Append file
; Append to a file and always ask
APPEND: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Append file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,OUTFLN
MOVE FSPBLK+1 ? MOVEM OUTEXT
MOVE FSPBLK+3 ? MOVEM OUTPPN
LOOKUP DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM OUTFLN ; toss away default
POPJ P,]
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
UGETF DSO, ; start appending
SETOM OUTFLP
POPJ P,
; Append but try using defaults
DAPPND: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
SKIPN X,OUTFLN
JRST APPEND
MOVEM X,FSPBLK
MOVE X,OUTEXT
MOVEM X,FSPBLK+1
SETZM FSPBLK+2
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
LOOKUP DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM OUTFLN ; toss away default
POPJ P,]
MOVE X,OUTPPN
MOVEM X,FSPBLK+3
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
UGETF DSO, ; start appending
SETOM OUTFLP
OUTSTR [ASCIZ/Appending to file /]
MOVE X,OUTFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,OUTEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/]
/]
POPJ P,
;CLSOFL OPNOFL
SUBTTL Output file
; Close output file
CLSOFL: AOSE OUTFLP ; file open?
POPJ P,
CLOSE DSO, ; close output
OUTSTR [ASCIZ/Output file /]
MOVE X,OUTFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,OUTEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,OUTPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/] closed.
/]
POPJ P,
; Open output file
OPNOFL: SKIPGE OUTFLP ; file open?
JRST [ OUTSTR [ASCIZ/Output file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Output file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,OUTFLN
MOVE FSPBLK+1 ? MOVEM OUTEXT
MOVE FSPBLK+3 ? MOVEM OUTPPN
ENTER DSO,FSPBLK
JRST [ OUTSTR [ASCIZ/ENTER failed!
/]
POPJ P,]
SETOM OUTFLP
POPJ P,
;CLSIFL OPNIFS OPNIFL
SUBTTL Input file
; Close input file
CLSIFL: AOSE INPFLP ; file open?
POPJ P,
CLOSE DSI, ; close input
OUTSTR [ASCIZ/Input file /]
MOVE X,INPFLN
PUSHJ P,OUTSIX
OUTCHR [".]
MOVE X,INPEXT
PUSHJ P,OUTSIX
OUTCHR ["[] ;]
HLLZ X,INPPPN
PUSHJ P,OUTSIX
OUTCHR [",]
HRLZ X,INPPPN
PUSHJ P,OUTSIX
OUTSTR [ASCIZ/] closed.
/]
SETZM SLOWFP
POPJ P,
; Open input file
OPNIFS: SETOM SLOWFP
OPNIFL: SKIPGE INPFLP ; file open?
JRST [ OUTSTR [ASCIZ/Input file already open!
/]
POPJ P,]
OUTSTR [ASCIZ/Input file name: /]
PUSHJ P,GETFSP ; get filespec
SKIPN X,FSPBLK
POPJ P,
MOVEM X,INPFLN
MOVE FSPBLK+1 ? MOVEM INPEXT
MOVE FSPBLK+3 ? MOVEM INPPPN
LOOKUP DSI,FSPBLK
JRST [ OUTSTR [ASCIZ/LOOKUP failed!
/]
SETZM SLOWFP
POPJ P,]
SETOM INPFLP
POPJ P,
;DDTCAL HLPMES
SUBTTL DDT bopper
DDTCAL: SKIPN JOBDDT
JRST [ OUTSTR [ASCIZ/No DDT./]
EXIT 1,
POPJ P,] ; no DDT!
OUTSTR [ASCIZ/You're in DDT.
/]
HRROI [002000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; leave special activation mode
PTJOBX [0 ? 4]
PUSHJ P,[POP P,JOBOPC ; enter DDT
JRST @JOBDDT]
PTJOBX [0 ? 3]
HRROI [001000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; enter special activation mode
POPJ P,
; As random a place as any to put it
HLPMES: ASCIZ/Type a command specificiation in the form:
socket-number,host
where host is the host name or number of the remote site, and
socket-number is the contact socket number of the server of that
site you wish to talk to. The socket number, if present, must
be followed by a comma or an atsign. The default socket number
is 1 for the OTN monitor command and 27 otherwise.
For more information, see the Monitor Command Manual, online
as MONCOM.BH[S,DOC].
/
;GETFSP NOEXT FSPEOS FSPCCR FSPDUN FSPLUZ
SUBTTL Filespec input
; Smashes X, Y, and Z; sets up FSPBLK.
GETFSP: HRROI [002000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; leave special activation mode
IFE FTDPYP,[
HRROI [012000,,10]
SKIPE TRANSP
TTYSET ; leave image mode
];IFE FTDPYP
PTJOBX [0 ? 4] ; echo filespec
SETZM FSPBLK ? SETZM FSPBLK+1 ? SETZM FSPBLK+2
SETZ X,
DSKPPN X,
MOVEM X,FSPBLK+3
PUSHJ P,GETSIX ; get file name
JUMPE X,FSPLUZ
MOVEM X,FSPBLK ; got file name
CAIE Y,".
JRST NOEXT
PUSHJ P,GETSIX ; try for extension
MOVEM X,FSPBLK+1
NOEXT: CAIN Y,↑J
JRST FSPDUN
CAIE Y,"[ ; must be a PPN
JRST FSPLUZ
PUSHJ P,GETSIX
TRNE X,-1
JRST FSPLUZ
TLNN X,77
JUMPN X,[LSH X,-6 ? JRST .-1]
SKIPE X
HLLM X,FSPBLK+3
CAIE Y,",
JRST FSPEOS
PUSHJ P,GETSIX
TRNE X,-1
JRST FSPLUZ
TLNN X,77
JUMPN X,[LSH X,-6 ? JRST .-1]
SKIPE X
HLRM X,FSPBLK+3
FSPEOS: CAIN Y,"]
FSPCCR: INCHWL Y
ANDI Y,177
CAIN Y,↑M
JRST FSPCCR
CAIE Y,↑J
JRST FSPLUZ
FSPDUN: PTJOBX [0 ? 3]
HRROI [001000,,(SPCBRK)]
SKIPE CHARMP
TTYSET ; enter special activation mode
IFE FTDPYP,[
HRROI [011000,,10]
SKIPE TRANSP
TTYSET ; enter image mode
];IFE FTDPYP
POPJ P,
FSPLUZ: CLRBFI
CAIN Y,175
JRST [ SETZM FSPBLK ; sorry defaulters
OUTSTR [ASCIZ/ Aborted.
/]
JRST FSPDUN]
OUTSTR [ASCIZ/Invalid filespec. Try again: /]
JRST GETFSP
;OUTSIX OUTSX1 GETSIX GETSX1 SWINIR SWINR1 SWINR2 ...LIT
SUBTTL Sixbit & numeric TTY I/O
; Sixbit output routine. Takes a word in X, smashes Y, flushes spaces.
OUTSIX: SETZ Y,
ROTC X,6
JUMPE Y,OUTSX1
ADDI Y,"A-'A
OUTCHR Y
OUTSX1: JUMPN X,OUTSIX
POPJ P,
; Sixbit input routine. Inputs a sixbit word in X, smashes Y and Z.
GETSIX: SETZ X,
MOVE Z,[440600,,X]
GETSX1: INCHWL Y
ANDI Y,177
CAIN Y,↑M
JRST GETSX1
CAIL Y,"a ; convert to upper case
CAILE Y,"z
CAIA
SUBI Y,"a-"A
CAIL Y,"0 ; only allow alphanumerics
CAILE Y,"Z
POPJ P,
CAILE Y,"9
CAIL Y,"A
CAIA
POPJ P,
SUBI Y,"A-'A ; convert to sixbit
TRNN X,77 ; don't go beyond last byte
IDPB Y,Z
JRST GETSX1
; Super winning numeric input routine. Numbers are parsed as both octal and
; decimal, unless either (a) an 8 or 9 appears in the number, or (b) the number
; is followed by a decimal point.
SWINIR: SETZB A,B ; A ← octal number, B ← decimal
SWINR1: CAIL X,"8 ; if can't be octal, A ← -1
SETO A,
JUMPL A,SWINR2
LSH A,3
ADDI A,-"0(X) ; bring in next octal digit
SWINR2: IMULI B,10.
ADDI B,-"0(X) ; bring in next decimal digit
ILDB X,Y
CAIN X,". ; decimal point ends spec and forces decimal
JRST [ SETO A,
ILDB X,Y
POPJ P,]
CAIL X,"0
CAILE X,"9
POPJ P, ; non-numeric, return
JRST SWINR1
;Super winning IP host number parser. If an IP host number is seen, IPHOST will
;be set and the number will be returned in B. Otherwise, just like SWINIR.
SWINIP: PUSHJ P,SWINIR ;Parse a number
CAIL X,"0 ;Check the next πharacter
CAILE X,"9
POPJ P, ;Not a digit, so not an IP host number
PUSH P,B ;Save 1st byte
PUSHJ P,SWINP1 ;Get rest of IP host number left-adj in B
POP P,A ;Restore 1st byte
LSHC A,-12. ;Right-adjust entire number in B
SETOB A,IPHOST ;Indicate IP host in B
POPJ P,
;Subroutine to return an IP host number left-adjusted in B.
SWINP1: PUSHJ P,SWINIR ;Get a number
PUSH P,B ;Save it
CAIL X,"0 ;See if a digit follows
CAILE X,"9
TDZA B,B ;No. Zero B and skip
PUSHJ P,SWINP1 ;Yes, get rest of IP host in B
POP P,A ;Get back current byte
LSHC A,-8. ;Shift into rest of number
POPJ P,
...LIT: CONSTANTS
END TELNET